CLEAR
SET LIBRARY TO HOME(1) + "foxtools.fll"
SET LIBRARY TO reduce.fll ADDITIVE
TestEmptyStrings()
TestSimpleCases()

LOCAL lcTest, lcTestCopy, ln1, lnSec

CREATE CURSOR results (version I, time B(6), resultLength I)

lcTest = REPLICATE(SPACE(16) + REPLICATE("1", 16), 1024*256)
? "First speed test. String length = " + + TRANSFORM(LEN(m.lcTest)/1024/1024) + " Mb"
FOR ln1 = 1 TO 10
 lcTestCopy = m.lcTest
 lnSec = SECONDS()
 Reduce_R(@lcTestCopy, " ", .F.)
 INSERT INTO results (version, time, resultLength) VALUES (1, SECONDS() - m.lnSec, LEN(m.lcTestCopy))

 lcTestCopy = m.lcTest
 lnSec = SECONDS()
 lcTestCopy = Reduce_V(m.lcTestCopy, " ", .F.)
 INSERT INTO results (version, time, resultLength) VALUES (2, SECONDS() - m.lnSec, LEN(m.lcTestCopy))

 * Incorrect with strings over 64k
 lcTestCopy = m.lcTest
 lnSec = SECONDS()
 lcTestCopy = Reduce(m.lcTestCopy)
 INSERT INTO results (version, time, resultLength) VALUES (3, SECONDS() - m.lnSec, LEN(m.lcTestCopy))

 lcTestCopy = m.lcTest
 lnSec = SECONDS()
 lcTestCopy = ReduceAsm(m.lcTestCopy, " ")
 INSERT INTO results (version, time, resultLength) VALUES (4, SECONDS() - m.lnSec, LEN(m.lcTestCopy))
 
 lcTestCopy = m.lcTest + SPACE(4)
 lnSec = SECONDS()
 lcTestCopy = ReduceAsm2(m.lcTestCopy)
 INSERT INTO results (version, time, resultLength) VALUES (5, SECONDS() - m.lnSec, LEN(m.lcTestCopy))
ENDFOR
SELECT PADR(ICASE(version=1, "IK fll by ref", version=2, "IK fll by val", ;
 version=3, "foxtools.fll", version=4, "leo asm", version=5, "modified leo asm"), 20) version, ;
 AVG(time) avg_time, MIN(time) min_time, MAX(time) max_time, resultLength ;
 FROM results GROUP BY version, resultLength INTO CURSOR results
LIST OFF
RELEASE lcTestCopy

? "Very long strings test"
IF !FILE("long.txt")
 CreateLongFile()
ENDIF
lcTest = FILETOSTR("long.txt")
? "Second speed test. String length = " + TRANSFORM(LEN(m.lcTest)/1024/1024) + " Mb"

lnSec = SECONDS()
Reduce_R(@lcTest, " ", .F.)
? "IK fll by ref", SECONDS() - m.lnSec, LEN(m.lcTest)

lcTest = FILETOSTR("long.txt")
lnSec = SECONDS()
lcTest = Reduce_V(m.lcTest, " ", .F.)
? "IK fll by value", SECONDS() - m.lnSec, LEN(m.lcTest)

* Incorrect results with long lines
*!*	lcTest = FILETOSTR("long.txt")
*!*	lnSec = SECONDS()
*!*	lcTest = Reduce(m.lcTest)
*!*	? "foxtools.fll", SECONDS() - m.lnSec, LEN(m.lcTest)

lcTest = FILETOSTR("long.txt")
lnSec = SECONDS()
lcTest = ReduceAsm2(m.lcTest)
? "modified leo asm", SECONDS() - m.lnSec, LEN(m.lcTest)

ERASE "long.txt"

PROCEDURE CreateLongFile
 LOCAL lcTest, ln1
 STRTOFILE("", "long.txt")
 lcTest = REPLICATE(SPACE(16) + REPLICATE("1", 16), 1024*256) && 8Mb
 FOR ln1 = 1 TO 25 && 200Mb
  STRTOFILE(m.lcTest, "long.txt", 1)
 ENDFOR
 STRTOFILE(SPACE(10), "long.txt", 1) && for modified leo asm
ENDPROC

FUNCTION ReduceAsm
LPARAMETER st, ch
IF LEN(m.ch)<1
 RETURN m.st
ENDIF
IF LEN(m.ch)>1
 ch=LEFT(m.ch,1)
ENDIF
IF EMPTY(m.st)
 RETURN ""
ENDIF

IF !PEMSTATUS(_SCREEN,"reduce_ptr",5)
 DECLARE INTEGER GetProcessHeap IN Win32API
 DECLARE INTEGER HeapAlloc IN Win32Api INTEGER, INTEGER, INTEGER
 DECLARE RtlMoveMemory IN Win32API INTEGER, STRING, INTEGER

 LOCAL hhnd, ptr, st2

 st2= ;
  CHR(85)+CHR(139)+CHR(236)+CHR(87)+CHR(86)+CHR(80)+ ;
  CHR(83)+CHR(81)+CHR(82)+CHR(139)+CHR(117)+CHR(8)+ ;
  CHR(139)+CHR(69)+CHR(12)+CHR(139)+CHR(125)+CHR(16)+ ;
  CHR(139)+CHR(93)+CHR(20)+CHR(139)+CHR(11)+CHR(51)+ ;
  CHR(219)+CHR(58)+CHR(6)+CHR(116)+CHR(14)+CHR(50)+ ;
  CHR(228)+CHR(255)+CHR(54)+CHR(143)+CHR(7)+CHR(70)+ ;
  CHR(71)+CHR(67)+CHR(73)+CHR(117)+CHR(240)+CHR(235)+ ;
  CHR(13)+CHR(128)+CHR(252)+CHR(1)+CHR(116)+CHR(4)+ ;
  CHR(254)+CHR(196)+CHR(235)+CHR(235)+CHR(70)+CHR(73)+ ;
  CHR(117)+CHR(225)+CHR(139)+CHR(77)+CHR(20)+CHR(137)+ ;
  CHR(25)+CHR(90)+CHR(89)+CHR(91)+CHR(88)+CHR(94)+ ;
  CHR(95)+CHR(139)+CHR(229)+CHR(93)+CHR(194)+CHR(16)+ ;
  CHR(0)

 hhnd=GetProcessHeap()
 ptr=HeapAlloc(m.hhnd,0,LEN(m.st2)+16)
 RtlMoveMemory(m.ptr,m.st2,LEN(m.st2))
 _SCREEN.ADDPROPERTY("reduce_ptr",m.ptr)
ENDIF

LOCAL st3, ln
st3 = REPLICATE(CHR(0),LEN(m.st)+4)
ln = LEN(m.st)

DECLARE CallWindowProc IN Win32API INTEGER, STRING, INTEGER, STRING @, INTEGER @
CallWindowProc(_SCREEN.reduce_ptr, m.st + "    ", ASC(m.ch), @m.st3, @m.ln)
*ALLTRIM needed to conform foxtools.fll behaviour
*RETURN ALLTRIM(LEFT(m.st3, m.ln))
RETURN LEFT(m.st3, m.ln)


FUNCTION ReduceAsm2
LPARAMETER st
IF LEN(m.st) < 5
 RETURN ReduceAsm(m.st, " ")
ENDIF
IF !PEMSTATUS(_SCREEN,"reduce_ptr",5)
 ReduceAsm("1"," ") && to create asm routine
ENDIF

ln = LEN(m.st) - 4
* Ignore last 4 characters to use ASM routine without previous string manipulation
DECLARE CallWindowProc IN Win32API INTEGER, STRING, INTEGER, STRING @, INTEGER @
CallWindowProc(_SCREEN.reduce_ptr, m.st, 32, @st, @ln)
*ALLTRIM needed to conform foxtools.fll behaviour
*RETURN ALLTRIM(LEFT(m.st3, m.ln))
RETURN LEFT(m.st, m.ln)

* Testing stuff

PROCEDURE TestEmptyStrings
AssertEmpty("", "empty string")
AssertEmpty(" ", "1 space string")
AssertEmpty(SPACE(2), "2 space string")
AssertEmpty(SPACE(3), "3 space string")
AssertEmpty(SPACE(4), "4 space string")
AssertEmpty(SPACE(5), "5 space string")
AssertEmpty(SPACE(15), "15 space string")
AssertEmpty(SPACE(16), "16 space string")
AssertEmpty(SPACE(17), "17 space string")
AssertEmpty(SPACE(65536), "64k space string")
AssertEmpty(SPACE(16777184-4), "max length (16m) space string")&& -4 for leo code that add 4 spaces
ENDPROC

PROCEDURE TestSimpleCases
AssertEqual("1", "1", "1 char string")
AssertEqual("123", "123", "3 char string")
AssertEqual("12345", "12345", "5 char string")
AssertEqual("1 ", "1", "CS string")
AssertEqual(" 1", "1", "SC string")
AssertEqual(" 1 ", "1", "SCS string")
AssertEqual("1  ", "1", "CSS string")
AssertEqual(" 1", "1", "SSC string")
AssertEqual("  1  ", "1", "SSCSS string")
AssertEqual("  11  ", "11", "SSCCSS string")
AssertEqual("  123  ", "123", "SSCCCSS string")
AssertEqual("  123  ", "123", "SSCCCSS string")
AssertEqual("123 123 123", "123 123 123", "single spaces string")
AssertEqual("123  123 123", "123 123 123", "1 doubled space string")
AssertEqual("123  123  123", "123 123 123", "2 doubled space string")
AssertEqual("123  123    123", "123 123 123", "2 doubled space (4 spaces) string")
AssertEqualLenDisplay(REPLICATE("1 2 ", 100) + "3", REPLICATE("1 2 ", 100)+"3", "long CS sequence")
AssertEqualLenDisplay(REPLICATE("1  2   ", 100) + "3", REPLICATE("1 2 ", 100)+"3", "long CSSS sequence")
AssertEqualLenDisplay(REPLICATE("1  2  ", 20000) + "3", REPLICATE("1 2 ", 20000)+"3", ">64k long CSSS sequence")
ENDPROC

#DEFINE C_REDUCE_FUNCTION_NAME Reduce_V
*#DEFINE C_REDUCE_FUNCTION_NAME IKReduceFllWrapper
*#DEFINE C_REDUCE_FUNCTION_NAME Reduce
*#DEFINE C_REDUCE_FUNCTION_NAME ReduceAsm

PROCEDURE IKReduceFllWrapper(tcInput, tcDeduplicateChar)
Reduce_R(@tcInput, m.tcDeduplicateChar)
RETURN m.tcInput
ENDPROC

PROCEDURE AssertEqual(tcInput, tcExpectedValue, tcMessage)
LOCAL lcResult
lcResult = C_REDUCE_FUNCTION_NAME(m.tcInput, " ")
IF !(m.lcResult == m.tcExpectedValue)
 ? "Error in " + EVL(m.tcMessage, "unnamed test") + ". Expected : [" + m.tcExpectedValue + "], got [" + m.lcResult + "]"
ENDIF
ENDPROC

PROCEDURE AssertEqualLenDisplay(tcInput, tcExpectedValue, tcMessage)
LOCAL lcResult
lcResult = C_REDUCE_FUNCTION_NAME(m.tcInput, " ")
IF !(m.lcResult == m.tcExpectedValue)
 ? "Error in " + EVL(m.tcMessage, "unnamed test") + ". Expected " + TRANSFORM(LEN(m.tcExpectedValue)) + " bytes, got " + TRANSFORM(LEN(m.lcResult)) + " bytes"
ENDIF
ENDPROC

PROCEDURE AssertEmpty(tcInput, tcMessage)
LOCAL lcResult
lcResult = C_REDUCE_FUNCTION_NAME(m.tcInput, " ")
IF LEN(m.lcResult) <> 0
 ? "Error in " + EVL(m.tcMessage, "unnamed test") + ". Expected empty value, got [" + m.lcResult + "]"
ENDIF
ENDPROC
